home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / Talk 1.0.6 / My Libraries / MyPreferences.unit < prev    next >
Encoding:
Text File  |  1992-04-20  |  4.3 KB  |  155 lines  |  [TEXT/PJMM]
  1. e; id: integer; var h: handle): integer;
  2.     procedure SetPrefsResource (res: resType; id: integer; h: handle);
  3.  
  4. implementation
  5.  
  6.     procedure GetPrefsFSSpec (var fs: FSSpec);
  7.         var
  8.             gv: longInt;
  9.             oe: OSErr;
  10.             pb: HParamBlockRec;
  11.             sysenv: SysEnvRec;
  12.             s: str255;
  13.             dummy: longInt;
  14.     begin
  15.         if (Gestalt(gestaltFindFolderAttr, gv) <> noErr) | (not BTST(gv, gestaltFindFolderPresent)) | (FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, fs.vRefNum, fs.parID) <> NoErr) then begin
  16.             oe := SysEnvirons(1, sysenv);
  17.             with pb do begin
  18.                 fs.vRefNum := sysenv.sysVRefNum;
  19.                 s := 'Preferences';
  20.                 if DirCreate(sysenv.sysVRefNum, 0, s, fs.parID) <> noErr then begin
  21.                     ioNamePtr := @s;
  22.                     ioVRefNum := fs.vRefNum;
  23.                     ioFDirIndex := 0;
  24.                     ioDirID := 0;
  25.                     if (PBGetCatInfo(@pb, false) = noErr) & (BAND(ioFlAttrib, $0010) <> 0) then
  26.                         fs.parID := pb.ioDirID
  27.                     else
  28.                         fs.parID := 0;
  29.                 end;
  30.             end;
  31.         end;
  32.         GetIndString(s, prefsStrhResID, prefsNameStrhIndex);
  33.         fs.name := s;
  34.     end;
  35.  
  36.     function OpenPrefsFile (fs: FSSpec): integer;
  37.     begin
  38.         OpenPrefsFile := HOpenResFile(fs.vRefNum, fs.parID, fs.name, fsRdPerm);
  39.     end;
  40.  
  41.     function MakePrefsFile (fs: FSSpec): integer;
  42.         const
  43.             finderLaunchStrID = -16397;
  44.         var
  45.             oe: OSErr;
  46.             sh: stringHandle;
  47.             s: str255;
  48.             rn: integer;
  49.     begin
  50.         oe := HCreate(fs.vRefNum, fs.parID, fs.name, prefsCreator, prefsType);
  51.         HCreateResFile(fs.vRefNum, fs.parID, fs.name);
  52.         rn := HOpenResFile(fs.vRefNum, fs.parID, fs.name, fsRdWrPerm);
  53.         if rn <> -1 then begin
  54.             sh := stringHandle(Get1Resource('STR ', finderLaunchStrID));
  55.             if sh = nil then begin
  56.                 GetIndString(s, prefsStrhResID, prefsFinderCommentStrhIndex);
  57.                 sh := NewString(s);
  58.                 if sh <> nil then
  59.                     AddResource(handle(sh), 'STR ', finderLaunchStrID, 'Finder launch string');
  60.             end;
  61.         end;
  62.         MakePrefsFile := rn;
  63.     end;
  64.  
  65.     type
  66.         prefsPtr = ^prefsRecord;
  67.         prefsHandle = ^prefsPtr;
  68.  
  69.     procedure GetPrefs (var prefs: prefsRecord);
  70.         var
  71.             h: handle;
  72.     begin
  73.         h := GetResource(prefsResType, prefsResID);
  74.         prefs.version := -1;
  75.         if (h <> nil) & (GetHandleSize(h) = SizeOf(prefsRecord)) then
  76.             prefs := prefsHandle(h)^^;
  77.         ValidatePrefs(prefs);
  78.     end;
  79.  
  80.     procedure SetPrefs (var prefs: prefsRecord);
  81.         var
  82.             h: handle;
  83.             i: integer;
  84.     begin
  85.         h := Get1Resource(prefsResType, prefsResID);
  86.         if h = nil then begin
  87.             h := NewHandle(SizeOf(prefsRecord));
  88.             if h <> nil then
  89.                 AddResource(h, prefsResType, prefsResID, 'Prefs');
  90.         end;
  91.         if h <> nil then begin
  92.             SetHandleSize(h, SizeOf(prefsRecord));
  93.             prefsHandle(h)^^ := prefs;
  94.             ChangedResource(h);
  95.         end;
  96.     end;
  97.  
  98.     procedure JustGetPrefs (var prefs: prefsRecord);
  99.         var
  100.             prefs_fs: FSSpec;
  101.             prefs_rn: integer;
  102.     begin
  103.         GetPrefsFSSpec(prefs_fs);
  104.         prefs_rn := OpenPrefsFile(prefs_fs);
  105.         GetPrefs(prefs);
  106.         if prefs_rn <> -1 then
  107.             CloseResFile(prefs_rn);
  108.     end;
  109.  
  110.     procedure JustSetPrefs (var prefs: prefsRecord);
  111.         var
  112.             prefs_fs: FSSpec;
  113.             prefs_rn: integer;
  114.     begin
  115.         GetPrefsFSSpec(prefs_fs);
  116.         prefs_rn := MakePrefsFile(prefs_fs);
  117.         if prefs_rn <> -1 then begin
  118.             SetPrefs(prefs);
  119.             CloseResFile(prefs_rn);
  120.         end;
  121.     end;
  122.  
  123.     function GetPrefsResource (res: resType; id: integer; var h: handle): integer;
  124.         var
  125.             prefs_fs: FSSpec;
  126.             prefs_rn: integer;
  127.     begin
  128.         GetPrefsFSSpec(prefs_fs);
  129.         prefs_rn := OpenPrefsFile(prefs_fs);
  130.         h := GetResource(res, id);
  131.         GetPrefsResource := prefs_rn;
  132.     end;
  133.  
  134.     procedure SetPrefsResource (res: resType; id: integer; h: handle);
  135.         var
  136.             prefs_fs: FSSpec;
  137.             prefs_rn: integer;
  138.             h2: handle;
  139.     begin
  140.         if h <> nil then begin
  141.             GetPrefsFSSpec(prefs_fs);
  142.             prefs_rn := MakePrefsFile(prefs_fs);
  143.             if prefs_rn <> -1 then begin
  144.                 h2 := Get1Resource(res, id);
  145.                 if h2 <> nil then begin
  146.                     RmveResource(h2);
  147.                     DisposHandle(h2);
  148.                 end;
  149.                 AddResource(h, res, id, '');
  150.                 CloseResFile(prefs_rn);
  151.             end;
  152.         end;
  153.     end;
  154.  
  155. end.